home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / PROCES.f < prev    next >
Text File  |  1992-07-31  |  9KB  |  218 lines
  1.       SUBROUTINE PROCES 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *   Processes one routine statement by statement:   
  5. *   filtering, replacements 
  6. *   
  7. *-----------------------------------------------------------------------
  8.       include 'PARAM.h' 
  9.       include 'ALCAZA.h' 
  10.       include 'CLASS.h' 
  11.       include 'FLAGS.h' 
  12.       include 'CURSTA.h' 
  13.       include 'STATE.h' 
  14.       include 'JOBSUM.h' 
  15.       LOGICAL SAMEST
  16. *--- treat routine header and init  
  17.       CALL RSTART   
  18. *--- TREE preparation if no proper header   
  19.       IF(ACTION(29).AND.SCROUT.EQ.'NOHEADER')  CALL TREEST(0)   
  20. *--- user top of routine
  21.       IF(ACTION(22))  CALL URINIT   
  22.     
  23. *--- NP controls the number of blank lines for print headers
  24.       NP=0  
  25. *--- process only if routine selected   
  26.       IF (STATUS(7))  THEN  
  27. *--- loop over all statements in routine
  28.          DO 60 IST=1,NSTAMM 
  29.             STATUS(8)=.TRUE.
  30.             STATUS(10)=.TRUE.   
  31.             STATUS(11)=.FALSE.  
  32.             IF (ICLASS(IST,1).GT.0)  THEN   
  33. *--- extract and set classes
  34.                CALL EXTRAC(IST,'FULL')  
  35.                ICURCL(1)=ICLASS(IST,1)  
  36.                ICURCL(2)=ICLASS(IST,2)  
  37.                IF (ICURCL(1).EQ.ILL) NFDCLS(ILL,1)=NFDCLS(ILL,1)+1  
  38.             ENDIF   
  39.             IF (ICLASS(IST,1).EQ.ILL.AND.ACTION(3))  THEN   
  40.                IF (STATUS(9))  THEN 
  41.                   STATUS(9)=.FALSE. 
  42.                   IF (ACTION(6))  THEN  
  43.                      WRITE (MPUNIT,10000) 'all',SCROUT  
  44.                   ELSE  
  45.                      WRITE (MPUNIT,10000) 'selected',SCROUT 
  46.                   ENDIF 
  47.                ENDIF
  48.                STATUS(10)=.FALSE.   
  49.                CALL FLPRNT(1,'illegal',NLLINE(IST)-NFLINE(IST)+1,SIMA(  
  50.      +         NFLINE(IST)),NSTATC(8))  
  51.                NP=1 
  52. *--- print all if requested 
  53.             ELSEIF (ACTION(6))  THEN
  54. *--- routine header 
  55.                IF (STATUS(9))  THEN 
  56.                   STATUS(9)=.FALSE. 
  57.                   WRITE (MPUNIT,10000) 'all',SCROUT 
  58.                ENDIF
  59.                STATUS(10)=.FALSE.   
  60.                CALL FLPRNT(NP,' ',NLLINE(IST)-NFLINE(IST)+1,SIMA(NFLINE(
  61.      +         IST)),NSTATC(8)) 
  62.                NP=0 
  63.             ENDIF   
  64. *--- call user routine for ALL statements   
  65.             IF(ACTION(22))  CALL USSALL 
  66. *--- process only legal FORTRAN statements  
  67.             IF (ICLASS(IST,1).GT.0.AND.ICLASS(IST,1).NE.ILL)  THEN  
  68. *--- get statement number   
  69.                SNEWST(1)(1:6)=SIMA(NFLINE(IST))(1:6)
  70. *--- filter for classes 
  71.                IF (ACTION(17)) CALL FILTER(13,8)
  72.                IF (STATUS(8))  THEN 
  73. *--- get statement names
  74.                   ISNAME=IRNAME+NRNAME  
  75.                   CALL GETALL   
  76. *--- filter for names   
  77.                   IF (ACTION(18)) CALL FILTER(11,8) 
  78.                   IF (STATUS(8))  THEN  
  79. *--- filter for strings 
  80.                      IF (ACTION(19)) CALL FILTER(12,8)  
  81.                      IF (STATUS(8))  THEN   
  82. *--- all filters passed - update statistics 
  83.                         IMODIF(IST)=1   
  84.                         NSTATC(4)=NSTATC(4)+1   
  85.                         NFDCLS(ICURCL(1),1)=NFDCLS(ICURCL(1),1)+1   
  86.                         IF (ICURCL(1).EQ.IIF) NFDCLS(ICURCL(2),2)=NFDCLS
  87.      +                  (ICURCL(2),2)+1 
  88. *--- user start of statement
  89.                         IF(ACTION(22))  CALL USSBEG 
  90. *--- prepare indentation if requested   
  91.                         IF(ACTION(21))  CALL PROIND 
  92. *----get type for variables 
  93.                         IF (ACTION(20)) CALL SETTYP(1)  
  94. *--- check for incorrect relational operators in character type 
  95.                         CALL CHKCHR 
  96. *--- treat names further if any 
  97.                         IF(NSNAME.GT.0)  THEN   
  98. *--- prepare TREE output
  99.                            IF(ACTION(29))  CALL TREEST(1)   
  100. *--- find used and unused common blocks 
  101.                            IF(ACTION(24).AND..NOT.STATUS(12))   
  102.      +                     CALL PROCOM  
  103. *--- perform name replacements  
  104.                            IF (ACTION(15)) CALL REPNAM  
  105.                            IF (STATUS(11)) GOTO 10  
  106.                            IF (ACTION(1).OR.ACTION(2))  THEN
  107. *--- add names to routine name list 
  108.                               CALL LSORT(SNAMES(ISNAME+1),  
  109.      +                        NAMTYP(ISNAME+1),.TRUE.,NSNAME)   
  110.                               CALL LMERGE(SNAMES,NAMTYP,.TRUE.,IRNAME,  
  111.      +                        NRNAME,NSNAME)
  112.                               CALL SUPMOR(SNAMES,NAMTYP,.TRUE.,IRNAME,  
  113.      +                        NRNAME+NSNAME,NRNAME) 
  114.                            ENDIF
  115.                         ENDIF   
  116.                         IF (ACTION(5).AND.STATUS(10))  THEN 
  117. *--- print filtered 
  118.                            IF (STATUS(9))  THEN 
  119.                               WRITE (MPUNIT,10000) 'filtered',SCROUT
  120.                               STATUS(9)=.FALSE. 
  121.                            ENDIF
  122.                            STATUS(10)=.FALSE.   
  123.                            CALL FLPRNT(NP,' ',NLLINE(IST)-NFLINE(IST)+1,
  124.      +                     SIMA(NFLINE(IST)),NSTATC(8)) 
  125.                            NP=0 
  126.                         ENDIF   
  127.                         IF (ACTION(11).OR.ACTION(12)) THEN  
  128. *--- remove {} , change holl. to quotes if requested
  129.                            CALL QUOSUB  
  130.                            IF (STATUS(11)) GOTO 10  
  131. *--- string replacement 
  132.                            IF(ACTION(12))  CALL REPSTR  
  133.                            IF (STATUS(11)) GOTO 10  
  134. *--- re-insert {} around strings for REFORM 
  135.                            CALL MARKST('FULL',IERR) 
  136.                            STATUS(11)=IERR.NE.0 
  137.                            IF (STATUS(11)) GOTO 10  
  138.                         ENDIF   
  139. *--- re-numbering if requested  
  140.                         IF (ACTION(13)) CALL RENUMB 
  141. *--- user end of statement  
  142.                         IF(ACTION(22))  CALL USSEND 
  143.                      ENDIF  
  144.                   ENDIF 
  145.                ENDIF
  146. *--- here you arrive without filter checks  
  147.    10          CONTINUE 
  148.                IFILTR=0 
  149.                IF (STATUS(11)) IMODIF(IST)=MOD(IMODIF(IST),10)  
  150. *--- reformat = put modified statement into SIMA
  151.                IF (IMODIF(IST).GT.10.OR.ACTION(21).AND.IMODIF(IST).GT.0)
  152.      +         THEN 
  153.                   CALL REFORM   
  154. *--- not changed if REFORM problem, or identical after REFORM   
  155.                   IF (STATUS(11).OR.SAMEST(IST))
  156.      +            IMODIF(IST)=MOD(IMODIF(IST),10)   
  157.                ENDIF
  158.                IF (IMODIF(IST).GT.10)  THEN 
  159. *--- count changed statements   
  160.                   NSTATC(5)=NSTATC(5)+1 
  161.                   IF (ACTION(4).AND.STATUS(10))  THEN   
  162. *--- print changed statements   
  163.                      IF (STATUS(9))  THEN   
  164.                         WRITE (MPUNIT,10000) 'changed',SCROUT   
  165.                         STATUS(9)=.FALSE.   
  166.                      ENDIF  
  167.                      CALL FLPRNT(1,' ',NLLINE(IST)-NFLINE(IST)+1,SIMA(  
  168.      +               NFLINE(IST)),NSTATC(8))
  169.                   ENDIF 
  170. *--- re-formatted statement in SNEWST   
  171. *   put into SIMA, push SIMA if new longer than old, introduce blank
  172. *   lines if new shorter than old   
  173.                   N=0   
  174.                   DO 20 I=NFLINE(IST),NLLINE(IST)   
  175.                      IF (NLTYPE(I).NE.0)  THEN  
  176.                         N=N+1   
  177.                         IF (N.GT.NEWOUT)  THEN  
  178.                            SIMA(I)=' '  
  179.                         ELSE
  180.                            SIMA(I)=SNEWST(N)
  181.                         ENDIF   
  182.                      ENDIF  
  183.    20             CONTINUE  
  184.                   NPUSH=NEWOUT-N
  185.                   IF (NPUSH.GT.0)  THEN 
  186.                      DO 30 I=NLINES,NLLINE(IST)+1,-1
  187.                         NLTYPE(I+NPUSH)=NLTYPE(I)   
  188.                         SIMA(I+NPUSH)=SIMA(I)   
  189.    30                CONTINUE   
  190.                      NLINES=NLINES+NPUSH
  191. *---  loop over all statements since they might be in a different order 
  192.                      DO 40 I=1,NSTAMM   
  193.                         IF(NFLINE(I).GT.NFLINE(IST)) THEN   
  194.                            NFLINE(I)=NFLINE(I)+NPUSH
  195.                            NLLINE(I)=NLLINE(I)+NPUSH
  196.                         ENDIF   
  197.    40                CONTINUE   
  198.                      DO 50 I=1,NPUSH
  199.                         SIMA(NLLINE(IST)+I)=SNEWST(N+I) 
  200.    50                CONTINUE   
  201.                      NLLINE(IST)=NLLINE(IST)+NPUSH  
  202.                   ENDIF 
  203.                   IF (ACTION(4))  THEN  
  204.                      CALL FLPRNT(0,'changed to',NLLINE(IST)-NFLINE(IST)+
  205.      +               1,SIMA(NFLINE(IST)),NDUMMY)
  206.                      NP=1   
  207.                   ENDIF 
  208.                ENDIF
  209.             ENDIF   
  210.    60    CONTINUE   
  211.       ENDIF 
  212. *--- user end of routine
  213.       IF(ACTION(22))  CALL URTERM   
  214. *--- TREE output if any 
  215.       IF(ACTION(29))  CALL TREESU   
  216. 10000 FORMAT(/1X,20('++++'),A10,' statements, routine =',A10)   
  217.   999 END   
  218.